home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lysrc.zip / YACCTABL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-24  |  28KB  |  924 lines

  1.  
  2. unit YaccTables;
  3.  
  4. (* 2-16-91 AG *)
  5.  
  6. (* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
  7.    6509 Schornsheim/Germany
  8.    All rights reserved *)
  9.  
  10. interface
  11.  
  12. uses YaccBase;
  13.  
  14. (* This module collects the various tables used by the Yacc program:
  15.    - the symbol table
  16.    - the rule table
  17.    - the precedence table
  18.    - the closure table
  19.    - the LALR state, item, transition and reduction table
  20.    Note: All tables are allocated dynamically (at initialization time)
  21.    because of the 64KB static data limit. *)
  22.  
  23. var max_bytes : LongInt;
  24.   (* available memory *)
  25.  
  26. function n_bytes : LongInt;
  27.   (* memory actually used *)
  28.  
  29. const
  30.  
  31. (* Maximum table sizes: *)
  32.  
  33. max_keys           =  997;  (* size of hash symbol table (prime number!)   *)
  34. max_nts            =  300;  (* maximum number of nonterminals              *)
  35. max_lits           =  556;  (* number of literals (300+256)                *)
  36. max_rules          =  301;  (* number of rules (300+1)                     *)
  37. max_types          =  100;  (* number of type tags                         *)
  38. max_prec           =   50;  (* maximum precedence level                    *)
  39. max_states         =  600;  (* number of LR(0) states                      *)
  40. max_items          = 2400;  (* number of items                             *)
  41. max_trans          = 2400;  (* number of transitions                       *)
  42. max_redns          = 1200;  (* number of reductions                        *)
  43.  
  44. max_rule_len       =   64;  (* maximum length of rules                     *)
  45. max_set_items      =   64;  (* maximum number of items in an item set      *)
  46.  
  47. var
  48.  
  49. (* Actual table sizes: *)
  50.  
  51. n_nts            : Integer;
  52. n_lits           : Integer;
  53. n_rules          : Integer;
  54. n_types          : Integer;
  55. n_prec           : Integer;
  56. n_states         : Integer;
  57. n_items          : Integer;
  58. n_trans          : Integer;
  59. n_redns          : Integer;
  60.  
  61. type
  62.  
  63. (* Table data structures: *)
  64.  
  65. (* Symbol table: The symbol table consists of a hash table which stores
  66.    print names and internal symbol numbers, and a key table which stores,
  67.    for each internal symbol number, the corresponding hash key. *)
  68.  
  69. SymRec = record
  70.            pname  : StrPtr;
  71.              (* print name; empty entries are denoted by pname=nil *)
  72.            deff   : Boolean;
  73.              (* flag denoting whether symbol is already defined *)
  74.            sym    : Integer;
  75.              (* internal symbol number (0 or positive: literal symbols
  76.                 (literal characters have symbol numbers 1 thru 255);
  77.                 negative: nonterminal symbols; 0 denotes endmarker,
  78.                 -1 augmented start nonterminal, 256 is reserved for
  79.                 error token; note that the predefined symbols except
  80.                 the error literal are not actually stored in the symbol
  81.                 table; the error symbol is entered at initialization
  82.                 s.t. it always has number 256) *)
  83.          end;
  84.  
  85. SymTable = array [1..max_keys] of SymRec;
  86.  
  87. SymKeyTable = array [-max_nts..max_lits-1] of Integer;
  88.   (* hash keys for nonterminal and literal symbols *)
  89.  
  90. (* Rule table: the rule table consists of an array storing the rules
  91.    sequentially in the order in which they appear in the source grammar;
  92.    a rule no.s table which is used to sort rules w.r.t. left-hand side
  93.    nonterminals (after the rule table has been constructed and sorted, all
  94.    references to rules are done indirectly via the rule_no array s.t. the
  95.    rules for each nonterminal can be accessed easily); and an offset table
  96.    which stores, for each nonterminal, the corresponding first and last
  97.    index in the rule no.s table. *)
  98.  
  99. RuleRec = record
  100.             lhs_sym : Integer; (* lhs nonterminal *)
  101.             rhs_len : Integer; (* length of rhs *)
  102.             rhs_sym : array [1..max_rule_len] of Integer;
  103.               (* rhs symbols *)
  104.           end;
  105.  
  106. RuleRecPtr = ^RuleRec;
  107.  
  108. RuleTable = array [1..max_rules] of RuleRecPtr;
  109.  
  110. RuleNoTable = array [1..max_rules] of Integer;
  111.  
  112. RuleOffsRec = record
  113.                 rule_lo, rule_hi : Integer;
  114.               end;
  115.  
  116. RuleOffsTable = array [1..max_nts] of RuleOffsRec;
  117.  
  118. (* Symbol type table: The symbol type table stores the types associated
  119.    with the nonterminal and terminal grammar symbols (0 if none). *)
  120.  
  121. TypeTable    = array [1..max_types] of Integer;
  122.   (* types declared in the definitions section *)
  123.  
  124. SymTypeTable = array [-max_nts..max_lits-1] of Integer;
  125.   (* symbol types *)
  126.  
  127. (* Precedence table: The precedence table stores the type of each
  128.    precedence level (left, right, nonassoc) and, for each literal
  129.    symbol and grammar rule, the assigned precedence level (precedence
  130.    level 0 if none). *)
  131.  
  132. PrecType = ( left, right, nonassoc );
  133.  
  134. PrecTable = array [1..max_prec] of PrecType;
  135.  
  136. SymPrecTable = array [0..max_lits-1] of Integer;
  137.  
  138. RulePrecTable = array [1..max_rules] of Integer;
  139.  
  140. (* Closure and first symbols table: The closure table stores, for each
  141.    nonterminal X, the set of those nonterminals Y for which there is a
  142.    rightmost derivation X =>+ Y ... . Similarly, the first set table
  143.    stores, for each nonterminal X, the set of literals a for which there
  144.    is a derivation X =>+ a ... . Both tables are of type SymSetTable.
  145.  
  146.    The nullable table stores, for each nonterminal, a flag denoting whether
  147.    the nonterminal is nullable (i.e. may be derived to the empty string).
  148.  
  149.    These tables are constructed by the routines in the YaccClosure unit,
  150.    and are used by the LALR parser construction algorithms in YaccLR0 and
  151.    YaccLookaheads. *)
  152.  
  153. SymSetTable = array [1..max_nts] of IntSetPtr;
  154.  
  155. NullableTable = array [1..max_nts] of Boolean;
  156.  
  157. (* State table:
  158.  
  159.    Each state stores the first and last index of the kernel items,
  160.    transitions and reductions belonging to it, and a hash key determined
  161.    from the kernel items which is used to speed up searches for existing
  162.    states.
  163.  
  164.    The items table stores the individual kernel items in the LR(0) set.
  165.    Each entry consists of a rule number together with the item position,
  166.    and a "next" field indicating the associated item in the successor state
  167.    (0 if there is none). The ItemSet type is used to retrieve and manipulate
  168.    individual item sets from the item table.
  169.  
  170.    The transition table stores the shift and goto transitions in each state
  171.    (each transition is denoted by a (symbol, next_state) pair). Similarly,
  172.    the reductions table stores the reductions in each state, where each
  173.    action is denoted by a (symbolset, ruleno) pair. *)
  174.  
  175. StateRec = record
  176.              item_lo, item_hi : Integer;
  177.              trans_lo, trans_hi : Integer;
  178.              redns_lo, redns_hi : Integer;
  179.              key : Integer;
  180.            end;
  181.  
  182. StateTable = array [0..max_states-1] of StateRec;
  183.  
  184. ItemRec = record
  185.             rule_no, pos_no : Integer;
  186.             next : Integer;
  187.           end;
  188.  
  189. ItemSet = record
  190.             n_items : Integer;
  191.             item    : array [1..max_set_items] of ItemRec;
  192.           end;
  193.  
  194. ItemTable = array [1..max_items] of ItemRec;
  195.  
  196. TransRec = record
  197.              sym, next_state : Integer;
  198.            end;
  199.  
  200. TransTable = array [1..max_trans] of TransRec;
  201.  
  202. RednRec = record
  203.             symset : IntSetPtr;
  204.             rule_no : Integer;
  205.           end;
  206.  
  207. RednTable = array [1..max_redns] of RednRec;
  208.  
  209. (* Lookaheads table: This table stores, for each kernel item, the
  210.    corresponding LALR(1) lookahead symbol sets. *)
  211.  
  212. LookaheadTable = array [1..max_items] of IntSetPtr;
  213.  
  214. (* The propagation table is used to keep track of how lookaheads are
  215.    propagated from kernel items to other lookahead sets. *)
  216.  
  217. PropList = ^PropEntry;
  218.  
  219. PropEntry = record
  220.               symset : IntSetPtr;
  221.               next : PropList;
  222.             end;
  223.  
  224. PropTable = array [1..max_items] of PropList;
  225.  
  226.  
  227. var
  228.  
  229. verbose           : Boolean;          (* status of the verbose option *)
  230. debug             : Boolean;          (* status of the debug option *)
  231. startnt           : Integer;          (* start nonterminal of grammar
  232.                                          (0 if undefined) *)
  233. sym_table         : ^SymTable;        (* symbol table *)
  234. sym_key           : ^SymKeyTable;     (* symbol keys *)
  235. rule_table        : ^RuleTable;       (* rule table *)
  236. type_table        : ^TypeTable;       (* type table *)
  237. sym_type          : ^SymTypeTable;    (* symbol types *)
  238. prec_table        : ^PrecTable;       (* precedence table *)
  239. sym_prec          : ^SymPrecTable;    (* literal symbols precedence *)
  240. rule_prec         : ^RulePrecTable;   (* rules precedence *)
  241. rule_no           : ^RuleNoTable;     (* rule no table *)
  242. rule_offs         : ^RuleOffsTable;   (* rule offset table *)
  243. closure_table     : ^SymSetTable;     (* closure table *)
  244. first_set_table   : ^SymSetTable;     (* first set table *)
  245. nullable          : ^NullableTable;   (* nullable flags table *)
  246. state_table       : ^StateTable;      (* LR(0) state table *)
  247. item_table        : ^ItemTable;       (* LR(0) kernel item table *)
  248. trans_table       : ^TransTable;      (* transition table *)
  249. redn_table        : ^RednTable;       (* reduction table *)
  250. lookahead_table   : ^LookaheadTable;  (* LALR lookaheads table *)
  251. prop_table        : ^PropTable;       (* lookahead propagation table *)
  252.  
  253.  
  254. (* Operations: *)
  255.  
  256. (* Symbol table routines: *)
  257.  
  258. function new_nt : Integer;
  259.   (* returns a new nonterminal number (<-1) *)
  260.  
  261. function new_lit : Integer;
  262.   (* returns a new literal number above 256 *)
  263.  
  264. procedure add_lit ( sym : Integer );
  265.   (* this routine allows to add a user-defined literal symbol;
  266.      the current literal symbols count is adjusted accordingly *)
  267.  
  268. function get_key ( symbol : String ) : Integer;
  269.   (* returns a hash key for symbol *)
  270.  
  271. procedure def_key ( k : Integer; sym : Integer );
  272.   (* defines k to be a new symbol with internal symbol number sym *)
  273.  
  274. function is_def_key ( k : Integer; var sym : Integer ) : Boolean;
  275.   (* checks whether symbol denoted by symbol table key k is already
  276.      defined; if so, returns the corresponding symbol number *)
  277.  
  278. function pname ( sym : Integer ) : String;
  279.   (* returns the print name of an internal symbol (`$end' for
  280.      symbol 0, `$accept' for nonterminal -1, and a single quoted
  281.      character for literals 1..255) *)
  282.  
  283. (* Rule table routines: *)
  284.  
  285. function newRuleRec ( r : RuleRec ) : RuleRecPtr;
  286.   (* obtains a dynamic copy of r (only the number of bytes actually
  287.      needed is allocated) *)
  288.  
  289. procedure add_rule ( r : RuleRecPtr );
  290.   (* add a rule to the rule table *)
  291.  
  292. procedure sort_rules;
  293.   (* sorts rules w.r.t. left-hand sides into the rule no table *)
  294.  
  295. procedure rule_offsets;
  296.   (* computes rule offsets after rules have been sorted *)
  297.  
  298. function n_nt_rules ( sym : Integer ) : Integer;
  299.   (* returns number of rules for nonterminal sym *)
  300.  
  301. (* Type Table routines: *)
  302.  
  303. procedure add_type ( k : Integer );
  304.   (* add a type identifier to the table *)
  305.  
  306. procedure sort_types;
  307.   (* sort the type table alphabetically, eliminate dups *)
  308.  
  309. function search_type ( symbol : String ) : Boolean;
  310.   (* search the sorted types table for the given type symbol *)
  311.  
  312. (* Precedence table routines: *)
  313.  
  314. function new_prec_level ( prec_type : PrecType ) : Integer;
  315.   (* adds a new precedence level of the denoted type; returns: the new
  316.      level *)
  317.  
  318. (* State table routines: *)
  319.  
  320. var act_state : Integer; (* state currently considered *)
  321.  
  322. procedure new_state;
  323.   (* build a new state *)
  324.  
  325. procedure add_item ( rule_no, pos_no : Integer );
  326.   (* add an item to the new state (initialize its next field to 0) *)
  327.  
  328. function add_state : Integer;
  329.   (* add the new state to the state table; if an equivalent state is already
  330.      in the table, dispose the new state, and return the existing state
  331.      number, otherwise return the new state number *)
  332.  
  333. procedure start_trans;
  334.   (* starts building transitions of the active state *)
  335.  
  336. procedure add_trans ( sym, next_state : Integer );
  337.   (* adds a transition to the active state *)
  338.  
  339. procedure end_trans;
  340.   (* ends transitions of the active state *)
  341.  
  342. procedure start_redns;
  343.   (* starts building reduction actions of the active state *)
  344.  
  345. procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
  346.   (* adds a reduction to the active state *)
  347.  
  348. procedure end_redns;
  349.   (* ends reduction actions of the active state *)
  350.  
  351. function n_state_items ( s : Integer ) : Integer;
  352. function n_state_trans ( s : Integer ) : Integer;
  353. function n_state_redns ( s : Integer ) : Integer;
  354.   (* return the number of kernel items, transitions and reductions in state
  355.      s, respectively *)
  356.  
  357. function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
  358.   (* find item (rule_no, pos_no) in state s; returns: the item number *)
  359.  
  360. (* Item set routines: *)
  361.  
  362. procedure empty_item_set ( var item_set : ItemSet );
  363.   (* initializes an empty item set *)
  364.  
  365. procedure include_item_set ( var item_set : ItemSet;
  366.                              rule_no, pos_no : Integer);
  367.   (* add the denoted item to the given item set *)
  368.  
  369. procedure get_item_set ( s : Integer; var item_set : ItemSet);
  370.   (* obtain the item set of state s from the item table *)
  371.  
  372. procedure closure ( var item_set : ItemSet );
  373.   (* compute the closure of item_set (using the closure table) *)
  374.  
  375. procedure sort_item_set ( var item_set : ItemSet );
  376.   (* sorts an item set w.r.t. position and rule numbers (higher positions,
  377.      lower rules first) *)
  378.  
  379. implementation
  380.  
  381. uses YaccMsgs;
  382.  
  383. function n_bytes : LongInt;
  384.   begin
  385.     n_bytes := max_bytes-memAvail
  386.   end(*n_bytes*);
  387.  
  388. (* Symbol table routines: *)
  389.  
  390. function new_nt : Integer;
  391.   begin
  392.     inc(n_nts);
  393.     if n_nts>max_nts then fatal(nt_table_overflow);
  394.     sym_type^[-n_nts] := 0;
  395.     new_nt := -n_nts;
  396.   end(*new_nt*);
  397.  
  398. function new_lit : Integer;
  399.   begin
  400.     inc(n_lits);
  401.     if n_lits>max_lits then fatal(lit_table_overflow);
  402.     sym_type^[n_lits-1] := 0;
  403.     sym_prec^[n_lits-1] := 0;
  404.     new_lit := n_lits-1;
  405.   end(*new_lit*);
  406.  
  407. procedure add_lit ( sym : Integer );
  408.   begin
  409.     if sym>n_lits then n_lits := sym;
  410.     if n_lits>max_lits then fatal(lit_table_overflow);
  411.     sym_type^[sym] := 0;
  412.     sym_prec^[sym] := 0;
  413.   end(*add_lit*);
  414.  
  415. {$F+}
  416. function lookup(k : Integer) : String;
  417. {$F-}
  418.   (* print name of symbol no. k *)
  419.   begin
  420.     with sym_table^[k] do
  421.       if pname=nil then
  422.         lookup := ''
  423.       else
  424.         lookup := pname^
  425.   end(*lookup*);
  426.  
  427. {$F+}
  428. procedure entry(k : Integer; symbol : String);
  429. {$F-}
  430.   (* enter symbol into table *)
  431.   begin
  432.     sym_table^[k].pname := newStr(symbol);
  433.   end(*entry*);
  434.  
  435. function get_key ( symbol : String ) : Integer;
  436.   begin
  437.     get_key := key(symbol, max_keys, lookup, entry);
  438.   end(*get_key*);
  439.  
  440. procedure def_key ( k : Integer; sym : Integer );
  441.   begin
  442.     sym_key^[sym] := k;
  443.     sym_table^[k].deff := true;
  444.     sym_table^[k].sym  := sym;
  445.   end(*def_key*);
  446.  
  447. function is_def_key ( k : Integer; var sym : Integer ) : Boolean;
  448.   begin
  449.     if sym_table^[k].deff then
  450.       begin
  451.         sym := sym_table^[k].sym;
  452.         is_def_key := true;
  453.       end
  454.     else
  455.       is_def_key := false
  456.   end(*is_def_key*);
  457.  
  458. function pname ( sym : Integer ) : String;
  459.   begin
  460.     case sym of
  461.       1..255 : pname := singleQuoteStr(chr(sym));
  462.       0      : pname := '$end';
  463.       -1     : pname := '$accept';
  464.       else if sym_table^[sym_key^[sym]].pname^[1]='''' then
  465.         pname := singleQuoteStr(
  466.                    copy( sym_table^[sym_key^[sym]].pname^,
  467.                          2,
  468.                          length(sym_table^[sym_key^[sym]].pname^)-2)
  469.                  )
  470.       else
  471.         pname := sym_table^[sym_key^[sym]].pname^
  472.     end;
  473.   end(*pname*);
  474.  
  475. (* Rule table: *)
  476.  
  477. function newRuleRec ( r : RuleRec ) : RuleRecPtr;
  478.   var rp : RuleRecPtr;
  479.   begin
  480.     getmem(rp, 2*sizeOf(Integer)+r.rhs_len*sizeOf(Integer));
  481.     move(r, rp^, 2*sizeOf(Integer)+r.rhs_len*sizeOf(Integer));
  482.     newRuleRec := rp;
  483.   end(*newRuleRec*);
  484.  
  485. procedure add_rule ( r : RuleRecPtr );
  486.   begin
  487.     inc(n_rules);
  488.     if n_rules>max_rules then fatal(rule_table_overflow);
  489.     rule_table^[n_rules] := r;
  490.   end(*add_rule*);
  491.  
  492. {$F+}
  493. function rule_less ( i, j : Integer ) : Boolean;
  494. {$F-}
  495.   begin
  496.     if rule_table^[rule_no^[i]]^.lhs_sym =
  497.        rule_table^[rule_no^[j]]^.lhs_sym then
  498.       rule_less := rule_no^[i] < rule_no^[j]
  499.     else
  500.       rule_less := rule_table^[rule_no^[i]]^.lhs_sym >
  501.                    rule_table^[rule_no^[j]]^.lhs_sym
  502.   end(*rule_less*);
  503.  
  504. {$F+}
  505. procedure rule_swap ( i, j : Integer );
  506. {$F-}
  507.   var x : Integer;
  508.   begin
  509.     x := rule_no^[i]; rule_no^[i] := rule_no^[j]; rule_no^[j] := x;
  510.   end(*rule_swap*);
  511.  
  512. procedure sort_rules;
  513.   var i : Integer;
  514.   begin
  515.     for i := 1 to n_rules do rule_no^[i] := i;
  516.     quicksort ( 1, n_rules, rule_less, rule_swap );
  517.   end(*sort_rules*);
  518.  
  519. procedure rule_offsets;
  520.   var i, sym : Integer;
  521.   begin
  522.     for sym := 1 to n_nts do with rule_offs^[sym] do
  523.       begin
  524.         rule_lo := 1; rule_hi := 0;
  525.       end;
  526.     i := 1;
  527.     while (i<=n_rules) do
  528.       begin
  529.         sym := rule_table^[rule_no^[i]]^.lhs_sym;
  530.         rule_offs^[-sym].rule_lo := i;
  531.         inc(i);
  532.         while (i<=n_rules) and
  533.               (rule_table^[rule_no^[i]]^.lhs_sym=sym) do
  534.           inc(i);
  535.         rule_offs^[-sym].rule_hi := i-1;
  536.       end;
  537.   end(*rule_offsets*);
  538.  
  539. function n_nt_rules ( sym : Integer ) : Integer;
  540.   begin
  541.     with rule_offs^[-sym] do
  542.       n_rules := rule_hi-rule_lo+1
  543.   end(*n_nt_rules*);
  544.  
  545. (* Type Table routines: *)
  546.  
  547. procedure add_type ( k : Integer );
  548.   begin
  549.     inc(n_types);
  550.     if n_types>max_types then fatal(type_table_overflow);
  551.     type_table^[n_types] := k;
  552.   end(*add_type*);
  553.  
  554. (* Routines to sort type identifiers alphabetically: *)
  555.  
  556. {$F+}
  557. function type_less ( i, j : Integer ) : Boolean;
  558. {$F-}
  559.   begin
  560.     type_less := sym_table^[type_table^[i]].pname^<
  561.                  sym_table^[type_table^[j]].pname^
  562.   end(*type_less*);
  563.  
  564. {$F+}
  565. procedure type_swap ( i, j : Integer );
  566. {$F-}
  567.   var x : Integer;
  568.   begin
  569.     x := type_table^[i];
  570.     type_table^[i] := type_table^[j];
  571.     type_table^[j] := x;
  572.   end(*type_swap*);
  573.  
  574. procedure sort_types;
  575.   var i, j, count, sym : Integer;
  576.   begin
  577.     (* sort: *)
  578.     quicksort(1, n_types, type_less, type_swap);
  579.     (* eliminate dups: *)
  580.     i := 1; j := 1; count := 0;
  581.     while i<=n_types do
  582.       begin
  583.         if i<>j then type_table^[j] := type_table^[i];
  584.         while (i<n_types) and (type_table^[i+1]=type_table^[i]) do
  585.           begin
  586.             inc(i); inc(count);
  587.           end;
  588.         inc(i); inc(j);
  589.       end;
  590.     dec(n_types, count);
  591.   end(*sort_types*);
  592.  
  593. function search_type ( symbol : String ) : Boolean;
  594.   var l, r, k : Integer;
  595.   begin
  596.     (* binary search: *)
  597.     l := 1; r := n_types;
  598.     k := l + (r-l) div 2;
  599.     while (l<r) and (sym_table^[type_table^[k]].pname^<>symbol) do
  600.       begin
  601.         if sym_table^[type_table^[k]].pname^<symbol then
  602.           l := succ(k)
  603.         else
  604.           r := pred(k);
  605.         k := l + (r-l) div 2;
  606.       end;
  607.     search_type := (k<=n_types) and (sym_table^[type_table^[k]].pname^=symbol);
  608.   end(*search_type*);
  609.  
  610. (* Precedence table routines: *)
  611.  
  612. function new_prec_level ( prec_type : PrecType ) : Integer;
  613.   begin
  614.     inc(n_prec);
  615.     if n_prec>max_prec then fatal(prec_table_overflow);
  616.     prec_table^[n_prec] := prec_type;
  617.     new_prec_level := n_prec;
  618.   end(*new_prec_level*);
  619.  
  620. (* State table: *)
  621.  
  622. procedure new_state;
  623.   begin
  624.     inc(n_states);
  625.     if n_states>max_states then fatal(state_table_overflow);
  626.     state_table^[n_states-1].item_lo := n_items+1;
  627.   end(*new_state*);
  628.  
  629. procedure add_item ( rule_no, pos_no : Integer );
  630.   begin
  631.     inc(n_items);
  632.     if n_items>max_items then fatal(item_table_overflow);
  633.     item_table^[n_items].rule_no := rule_no;
  634.     item_table^[n_items].pos_no  := pos_no;
  635.     item_table^[n_items].next    := 0;
  636.   end(*add_item*);
  637.  
  638. function add_state : Integer;
  639.   function state_key ( s : Integer ) : Integer;
  640.     (* determines a hash key for state s *)
  641.     const max_key = 4001;
  642.       (* should be prime number s.t. hash keys are distributed
  643.          evenly *)
  644.     var i, k : Integer;
  645.     begin
  646.       with state_table^[s] do
  647.         begin
  648.           k := 0;
  649.           for i := item_lo to item_hi do
  650.             with item_table^[i] do
  651.               inc(k, rule_no+pos_no);
  652.           state_key := k mod max_key;
  653.         end;
  654.     end(*state_key*);
  655.   function search_state ( s, lo, hi : Integer; var t : Integer ) : Boolean;
  656.     (* searches the range lo..hi in the state table for a state with the
  657.        same kernel items as s; returns true if found, and then the
  658.        corresponding state number in t *)
  659.     function eq_items(s, t : Integer) : Boolean;
  660.       (* compares kernel item sets of states s and t *)
  661.       var i, i_s, i_t : Integer;
  662.       begin
  663.         if n_state_items(s)<>n_state_items(t) then
  664.           eq_items := false
  665.         else
  666.           begin
  667.             i_s := state_table^[s].item_lo;
  668.             i_t := state_table^[t].item_lo;
  669.             for i := 0 to n_state_items(s)-1 do
  670.               if (item_table^[i_s+i].rule_no<>item_table^[i_t+i].rule_no) or
  671.                  (item_table^[i_s+i].pos_no<>item_table^[i_t+i].pos_no) then
  672.                 begin
  673.                   eq_items := false;
  674.                   exit;
  675.                 end;
  676.             eq_items := true;
  677.           end
  678.       end(*eq_items*);
  679.     var t1 : Integer;
  680.     begin
  681.       with state_table^[s] do
  682.         for t1 := lo to hi do
  683.           if (key=state_table^[t1].key) and
  684.              eq_items(s, t1) then
  685.             begin
  686.               search_state := true;
  687.               t := t1;
  688.               exit;
  689.             end;
  690.       search_state := false;
  691.     end(*search_state*);
  692.   var s : Integer;
  693.   begin
  694.     with state_table^[n_states-1] do
  695.       begin
  696.         item_hi := n_items;
  697.         key := state_key(n_states-1);
  698.         if search_state(n_states-1, 0, n_states-2, s) then
  699.           begin
  700.             n_items := item_lo;
  701.             dec(n_states);
  702.             add_state := s;
  703.           end
  704.         else
  705.           add_state := n_states-1;
  706.       end;
  707.   end(*add_state*);
  708.  
  709. procedure start_trans;
  710.   begin
  711.     state_table^[act_state].trans_lo := n_trans+1;
  712.   end(*start_trans*);
  713.  
  714. procedure add_trans ( sym, next_state : Integer );
  715.   begin
  716.     inc(n_trans);
  717.     if n_trans>max_trans then fatal(trans_table_overflow);
  718.     trans_table^[n_trans].sym        := sym;
  719.     trans_table^[n_trans].next_state := next_state;
  720.   end(*add_trans*);
  721.  
  722. procedure end_trans;
  723.   begin
  724.     state_table^[act_state].trans_hi := n_trans;
  725.   end(*end_trans*);
  726.  
  727. procedure start_redns;
  728.   begin
  729.     state_table^[act_state].redns_lo := n_redns+1;
  730.   end(*start_redns*);
  731.  
  732. procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
  733.   begin
  734.     inc(n_redns);
  735.     if n_redns>max_redns then fatal(redn_table_overflow);
  736.     redn_table^[n_redns].symset  := symset;
  737.     redn_table^[n_redns].rule_no := rule_no;
  738.   end(*add_redn*);
  739.  
  740. procedure end_redns;
  741.   begin
  742.     state_table^[act_state].redns_hi := n_redns;
  743.   end(*end_redns*);
  744.  
  745. function n_state_items ( s : Integer ) : Integer;
  746.   begin
  747.     with state_table^[s] do
  748.       n_state_items := item_hi-item_lo+1
  749.   end(*n_state_items*);
  750.  
  751. function n_state_trans ( s : Integer ) : Integer;
  752.   begin
  753.     with state_table^[s] do
  754.       n_state_trans := trans_hi-trans_lo+1
  755.   end(*n_state_trans*);
  756.  
  757. function n_state_redns ( s : Integer ) : Integer;
  758.   begin
  759.     with state_table^[s] do
  760.       n_state_redns := redns_hi-redns_lo+1
  761.   end(*n_state_redns*);
  762.  
  763. function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
  764.   var i : Integer;
  765.   begin
  766.     with state_table^[s] do
  767.       for i := item_lo to item_hi do
  768.         if (item_table^[i].rule_no=rule_no) and
  769.            (item_table^[i].pos_no=pos_no) then
  770.           begin
  771.             find_item := i;
  772.             exit;
  773.           end;
  774.     find_item := 0;
  775.   end(*find_item*);
  776.  
  777. (* Item set routines: *)
  778.  
  779. procedure empty_item_set ( var item_set : ItemSet );
  780.   begin
  781.     item_set.n_items := 0;
  782.   end(*empty_item_set*);
  783.  
  784. procedure include_item_set ( var item_set : ItemSet;
  785.                              rule_no, pos_no : Integer);
  786.   begin
  787.     with item_set do
  788.       begin
  789.         inc(n_items);
  790.         if n_items>max_set_items then fatal(item_table_overflow);
  791.         item[n_items].rule_no := rule_no;
  792.         item[n_items].pos_no  := pos_no;
  793.       end;
  794.   end(*include_item_set*);
  795.  
  796. procedure get_item_set ( s : Integer; var item_set : ItemSet);
  797.   begin
  798.     with state_table^[s], item_set do
  799.       begin
  800.         n_items := n_state_items(s);
  801.         move(item_table^[item_lo], item, n_items*sizeOf(ItemRec));
  802.       end
  803.   end(*get_item_set*);
  804.  
  805. procedure closure ( var item_set : ItemSet );
  806.   var i, j : Integer;
  807.       nt_syms0, nt_syms : IntSet;
  808.   begin
  809.     with item_set do
  810.       begin
  811.         (* get the nonterminals at current positions in items: *)
  812.         empty(nt_syms0);
  813.         for i := 1 to n_items do
  814.           with item[i], rule_table^[rule_no]^ do
  815.             if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
  816.               include(nt_syms0, rhs_sym[pos_no]);
  817.         nt_syms := nt_syms0;
  818.         (* add closure symbols: *)
  819.         for i := 1 to size(nt_syms0) do
  820.           setunion(nt_syms, closure_table^[-nt_syms0[i]]^);
  821.         (* add the nonkernel items for the nonterminal symbols: *)
  822.         for i := 1 to size(nt_syms) do
  823.           with rule_offs^[-nt_syms[i]] do
  824.             for j := rule_lo to rule_hi do
  825.               include_item_set(item_set, rule_no^[j], 1);
  826.       end;
  827.   end(*closure*);
  828.  
  829. var sort_items : ItemSet;
  830.  
  831. (* comparison and swap routines for sort_item_set: *)
  832.  
  833. {$F+}
  834. function items_less ( i, j : Integer ) : Boolean;
  835. {$F-}
  836.   begin
  837.     with sort_items do
  838.       if item[i].pos_no=item[j].pos_no then
  839.         items_less := item[i].rule_no<item[j].rule_no
  840.       else
  841.         items_less := item[i].pos_no>item[j].pos_no
  842.   end(*items_less*);
  843.  
  844. {$F+}
  845. procedure items_swap ( i, j : Integer );
  846. {$F-}
  847.   var x : ItemRec;
  848.   begin
  849.     with sort_items do
  850.       begin
  851.         x := item[i]; item[i] := item[j]; item[j] := x;
  852.       end
  853.   end(*items_swap*);
  854.  
  855. procedure sort_item_set ( var item_set : ItemSet );
  856.   begin
  857.     sort_items := item_set;
  858.     quicksort(1, sort_items.n_items, items_less, items_swap);
  859.     item_set := sort_items;
  860.   end(*sort_item_set*);
  861.  
  862. var i : Integer;
  863.  
  864. begin
  865.  
  866.   verbose          := false;
  867.   debug            := false;
  868.   startnt          := 0;
  869.  
  870.   max_bytes := memAvail;
  871.  
  872.   n_nts            := 1;
  873.   n_lits           := 257;
  874.   n_rules          := 0;
  875.   n_types          := 0;
  876.   n_prec           := 0;
  877.   n_states         := 0;
  878.   n_items          := 0;
  879.   n_trans          := 0;
  880.   n_redns          := 0;
  881.  
  882.   (* allocate tables: *)
  883.  
  884.   new(sym_table);
  885.   new(sym_key);
  886.   new(rule_table);
  887.   new(rule_no);
  888.   new(rule_offs);
  889.   new(type_table);
  890.   new(sym_type);
  891.   new(prec_table);
  892.   new(sym_prec);
  893.   new(rule_prec);
  894.   new(closure_table);
  895.   new(first_set_table);
  896.   new(nullable);
  897.   new(state_table);
  898.   new(item_table);
  899.   new(trans_table);
  900.   new(redn_table);
  901.   new(lookahead_table);
  902.   new(prop_table);
  903.  
  904.   (* initialize symbol table: *)
  905.  
  906.   for i := 1 to max_keys do
  907.     with sym_table^[i] do
  908.       begin
  909.         pname := nil;
  910.         deff  := false;
  911.       end;
  912.  
  913.   (* enter predefined error symbol into symbol table: *)
  914.  
  915.   def_key(get_key('error'), 256);
  916.  
  917.   (* initialize type and precedence tables: *)
  918.  
  919.   for i := -max_nts to max_lits-1 do sym_type^[i] := 0;
  920.   for i := 0 to max_lits-1 do sym_prec^[i] := 0;
  921.   for i := 1 to max_rules do rule_prec^[i] := 0;
  922.  
  923. end(*YaccTables*).
  924.